home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / powerlogo-1.4 / examples / turtles < prev   
Encoding:
Text File  |  1996-07-16  |  9.1 KB  |  362 lines
  1.  
  2. ;  Examples of turtle graphics procedures.
  3.  
  4.  
  5. ; *********************************************************************
  6. ;  snowflake      size depth-limit
  7. ;     The Koch snowflake.
  8. ;  snowflake 100 3
  9.  
  10. make "snowflake [
  11.    procedure [ [ :size :depth ] [ ] [ :d ] ]
  12.    make "d * 0.577350269189626 :size
  13.    pu
  14.    bk :d
  15.    lt 30
  16.    pd
  17.    flake :size :depth
  18.    rt 120
  19.    flake :size :depth
  20.    rt 120
  21.    flake :size :depth
  22.    rt 150
  23.    pu
  24.    fd :d
  25.    pd ]
  26.  
  27. ;  One side of the snowflake.
  28.  
  29. make "flake [
  30.    procedure [ [ :size :depth ] ]
  31.    if =0 :depth [ fd :size stop ] [ ]
  32.    make "size / :size 3
  33.    make "depth - :depth 1
  34.    flake :size :depth
  35.    lt 60
  36.    flake :size :depth
  37.    rt 120
  38.    flake :size :depth
  39.    lt 60
  40.    flake :size :depth ]
  41.  
  42. ; *********************************************************************
  43. ;  inspi          size angle increment ( turtle-pointer )
  44. ;     An angle increment spiral.
  45. ;  inspi 3 0 7
  46. ;  inspi 8 2 20
  47.  
  48. make "inspi [
  49.    procedure [ [ :side :angle :inc ] [ :tp ] [ :h :a ] ]
  50.    if listp :tp [ make "tp :t1 ] [ ]
  51.    make "h heading :tp
  52.    make "a :angle
  53.    dowhile
  54.    [  fd :side
  55.       rt :angle
  56.       make "angle remainder + :angle :inc 360 ]
  57.    [  not and = :h heading :tp = :angle :a ] ]
  58.  
  59. ; *********************************************************************
  60. ;  cornerpoly     size angle depth-limit factor
  61. ;     polygon with more polygons at it's corners.
  62. ;  cornerpoly 40 144 3 0.4
  63. ;  cornerpoly 30 90 4 0.5
  64. ;  cornerpoly 40 150 3 0.25
  65.  
  66. make "cornerpoly [
  67.    procedure [ [ :size :angle :limit :factor ] [ ] [ :totalturn ] ]
  68.    if =0 :limit [ stop ] [ ]
  69.    make "totalturn 0
  70.    dowhile 
  71.    [  fd :size
  72.       cornerpoly * :factor :size +- :angle - :limit 1 :factor
  73.       rt :angle
  74.       make "totalturn + :totalturn :angle ]
  75.    [  not =0 remainder :totalturn 360 ] ]
  76.  
  77. ; *********************************************************************
  78. ;  starspi
  79. ;     Crazy spirals.
  80.  
  81. make "starspi [
  82.    procedure [ [ ] [ ] [ :r1 :r2 :a1 :a2 :d :df ] ]
  83.    clean
  84.    home
  85.    setrgb :s1 1 item + 1 random 7   [  [ 15 15 15 ]
  86.                                        [ 15 0  0 ]
  87.                                        [ 15 15 0 ]
  88.                                        [ 0  15 0 ]
  89.                                        [ 0  15 15 ]
  90.                                        [ 3  2  15 ]
  91.                                        [ 15 0  15 ] ]
  92.    make "r1 + 30 random 25
  93.    make "r2 + 3 random 5
  94.    make "a1 * rand 360
  95.    make "a2 * rand 180
  96.    make "d 5
  97.    make "df + 1.05 * 0.25 rand
  98.    repeat :r1 [
  99.       repeat :r2 [
  100.          fd :d
  101.          rt :a2 ]
  102.       make "d * :d :df
  103.       rt :a1 ]
  104.    starspi
  105.    stop ]
  106.  
  107. ; *********************************************************************
  108. ;  tree           size size-limit factor angle
  109. ;     A simple turtle tree.
  110. ;  tree 50 5 0.5 45
  111. ;  tree 50 2 0.7 90
  112. ;  tree 40 3 0.6 15
  113.  
  114. make "tree [
  115.    procedure [ [ :size :limit :f :angle ] ]
  116.    if < :size :limit [ fd :size bk :size stop ] [ ]
  117.    fd :size
  118.    rt :angle
  119.    tree * :size :f :limit :f :angle
  120.    lt + :angle :angle
  121.    tree * :size :f :limit :f :angle
  122.    rt :angle
  123.    bk :size ]
  124.  
  125. ; *********************************************************************
  126. ;  leantree       size angle depth-limit
  127. ;     Another simple turtle tree.
  128. ;  leantree 10 25 6
  129. ;  leantree 8 10 8
  130.  
  131. make "leantree [
  132.    procedure [ [ :size :angle :level ] ]
  133.    fd :size
  134.    ltree :size :angle :level
  135.    bk :size ]
  136.  
  137. make "ltree [
  138.    procedure [ [ :size :angle :level ] ]
  139.    if =0 :level [ stop ] [ ]
  140.    lt :angle
  141.    fd :size
  142.    ltree :size :angle - :level 1
  143.    bk :size
  144.    rt * 2 :angle
  145.    fd / :size 2
  146.    ltree :size :angle - :level 1
  147.    bk / :size 2
  148.    lt :angle ]
  149.  
  150. ; *********************************************************************
  151. ;  sidetree
  152. ;     Yet another tree.
  153. ;  sidetree 6 0.5 10 55 0.75 0.65
  154.  
  155. make "sidetree [
  156.    procedure [ [  :size
  157.                   :size-limit
  158.                   :stem-angle
  159.                   :branch-angle
  160.                   :stem-factor
  161.                   :branch-factor ] ]
  162.    repeat 4
  163.    [  rt :stem-angle
  164.       fd :size ]
  165.    if > :size :size-limit
  166.    [  sidetree    * :size :stem-factor
  167.                   :size-limit
  168.                   :stem-angle
  169.                   :branch-angle
  170.                   :stem-factor
  171.                   :branch-factor
  172.       if >0 :stem-angle
  173.       [  lt :branch-angle
  174.          sidetree    * :size :branch-factor
  175.                      :size-limit
  176.                      +- :stem-angle
  177.                      :branch-angle
  178.                      :stem-factor
  179.                      :branch-factor
  180.          rt :branch-angle ]
  181.       [  rt :branch-angle
  182.          sidetree    * :size :branch-factor
  183.                      :size-limit
  184.                      +- :stem-angle
  185.                      :branch-angle
  186.                      :stem-factor
  187.                      :branch-factor
  188.          lt :branch-angle ] ] [ ]
  189.    repeat 4
  190.    [  bk :size
  191.       lt :stem-angle ] ]
  192.  
  193. ; *********************************************************************
  194. ;  fern           size size-limit
  195. ;     A simple fern leaf (a three branch tree).
  196. ;  fern 50 0.5
  197.  
  198. make "fern [
  199.    procedure [ [ :size :limit ] ]
  200.    if > :limit :size [ stop ] [ ]
  201.    fd * 0.18 :size
  202.    rt 4
  203.    fern * 0.82 :size :limit
  204.    rt 58
  205.    fern * 0.3 :size :limit
  206.    lt 122
  207.    fern * 0.3 :size :limit
  208.    rt 60
  209.    bk * 0.18 :size ]
  210.  
  211. ; *********************************************************************
  212. ;  fern2          size size-limit curl thickness node-spacing branch-angle
  213. ;     A more versatile fern leaf.
  214. ;  fern2 90 3 2 0.2 0.1 60
  215. ;  fern2 90 3 2 0.3 0.18 60
  216. ;  fern2 90 2 4 0.35 0.3 60
  217.  
  218. make "fern2 [
  219.    procedure [ [ :size :limit :curl :thick :nspace :angle ] [ ]
  220.                [ :d1 :d2 :a1 ] ]
  221.    make "d1 * :size :nspace
  222.    make "d2 * - 1 :nspace :size
  223.    fd :d1
  224.    if > :limit :size
  225.    [  make "a1 atan / :thick - 1 :nspace
  226.       fd :d2
  227.       rt :a1
  228.       bk :d2
  229.       fd :d2
  230.       lt + :a1 :a1
  231.       bk :d2
  232.       fd :d2
  233.       rt :a1
  234.       bk :d2 ]
  235.    [  rt :curl
  236.       fern2 :d2 :limit :curl :thick :nspace :angle
  237.       rt - :angle :curl
  238.       fern2 * :thick :size :limit :curl :thick :nspace :angle
  239.       lt + :angle :angle
  240.       fern2 * :thick :size :limit :curl :thick :nspace :angle
  241.       rt :angle ]
  242.    bk :d1 ]
  243.  
  244. ; *********************************************************************
  245. ;  golden-rect    size
  246. ;     Golden mean rectangle.
  247.  
  248. make "golden-rect [
  249.    procedure [ [ :size ] [ ] [ :m1 :m2 ] ]
  250.    make "m1 1.61803398874989
  251.    while [ not = :m1 :m2 ] [
  252.       make "m2 :m1
  253.       make "m1 + / 1 :m1 1 ]
  254.    golden-rect1 :size ]
  255.  
  256. make "golden-rect1 [
  257.    procedure [ [ :size ] [ ] [ :ms ] ]
  258.    make "ms / :size :m1
  259.    fd :size
  260.    rt 90
  261.    fd :ms   
  262.    rt 90
  263.    fd :size
  264.    rt 90
  265.    if < 0.2 :ms [ golden-rect1 :ms stop ] [ ] ]
  266.  
  267. ; *********************************************************************
  268. ;  s-dragon       size size-limit angle
  269. ;     Size limit dragon.
  270. ;  s-dragon 50 5 45
  271.  
  272. make "s-dragon [
  273.    procedure [ [ :size :size-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
  274.    make "angle2 - 90 :angle1
  275.    make "leg1  /  * 0.5 sin - 180 * 2 :angle1  sin :angle1
  276.    make "leg2  /  * 0.5 sin - 180 * 2 :angle2  sin :angle2
  277.    s-dragon1 :size 1 ]
  278.  
  279. make "s-dragon1 [
  280.    procedure [ [ :size :par ] ]
  281.    if > :size-limit :size [ fd :size stop ] [ ]
  282.    if >0 :par
  283.       [  rt :angle1
  284.          s-dragon1 * :size :leg1 1
  285.          lt 90
  286.          s-dragon1 * :size :leg2 -1
  287.          rt :angle2 ]
  288.       [  lt :angle2
  289.          s-dragon1 * :size :leg2 1
  290.          rt 90
  291.          s-dragon1 * :size :leg1 -1
  292.          lt :angle1 ] ]
  293.  
  294. ;  Lots of dragons.
  295.  
  296. make "s-dragons [
  297.    procedure [ [ ] [ ] [ :angle :size-limit ] ]
  298.    make "size-limit 80
  299.    while [ make "size-limit / :size-limit 3  > :size-limit 0.5 ] [
  300.       make "angle 0
  301.       while [ make "angle + :angle 5  < :angle 90 ] [
  302.          clean
  303.          home
  304.          pu
  305.          lt 70
  306.          bk 52
  307.          lt 20
  308.          pd
  309.          s-dragon 100 :size-limit :angle ] ] ]
  310.  
  311. ; *********************************************************************
  312. ;  d-dragon       size depth-limit angle
  313. ;     Depth limit dragon
  314. ;  d-dragon 50 5 45
  315.  
  316. make "d-dragon [
  317.    procedure [ [ :size :depth-limit :angle1 ] [ ] [ :leg1 :leg2 :angle2 ] ]
  318.    make "angle2 - 90 :angle1
  319.    make "leg1  /  * 0.5 sin - 180 * 2 :angle1  sin :angle1
  320.    make "leg2  /  * 0.5 sin - 180 * 2 :angle2  sin :angle2
  321.    d-dragon1 :size :depth-limit 1 ]
  322.  
  323. make "d-dragon1 [
  324.    procedure [ [ :size :depth-limit :par ] ]
  325.    if > 1 :depth-limit [ fd :size stop ] [ ]
  326.    make "depth-limit - :depth-limit 1
  327.    if >0 :par
  328.       [  rt :angle1
  329.          d-dragon1 * :size :leg1 :depth-limit 1
  330.          lt 90
  331.          d-dragon1 * :size :leg2 :depth-limit -1
  332.          rt :angle2 ]
  333.       [  lt :angle2
  334.          d-dragon1 * :size :leg2 :depth-limit 1
  335.          rt 90
  336.          d-dragon1 * :size :leg1 :depth-limit -1
  337.          lt :angle1 ] ]
  338.  
  339. ;  Lots of dragons.
  340.  
  341. make "d-dragons [
  342.    procedure [ [ ] [ ] [ :angle :depth-limit ] ]
  343.    make "depth-limit 3
  344.    while [ make "depth-limit + :depth-limit 3  < :depth-limit 12 ] [
  345.       make "angle 0
  346.       while [ make "angle + :angle 5  < :angle 90 ] [
  347.          clean
  348.          home
  349.          pu
  350.          lt 70
  351.          bk 52
  352.          lt 20
  353.          pd
  354.          d-dragon 100 :depth-limit :angle ] ] ]
  355.  
  356.  
  357. ; *********************************************************************
  358.  
  359. pr [ ]
  360. pr [ Examples of turtle graphics procedures. ]
  361. pr [ ]
  362.